home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tj50dsk1.zip / DIRTTT5.PAS next >
Pascal/Delphi Source File  |  1989-01-31  |  54KB  |  1,598 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}                                       
  13.                      {       Unit:   DirTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-}       
  18.  
  19. unit  DirTTT5;
  20.  
  21. (*
  22. {$DEFINE DIRFULL}
  23. *)
  24. INTERFACE
  25.  
  26. Uses DOS,CRT,FastTTT5,WinTTT5,StrnTTT5,KeyTTT5,ReadTTT5;
  27.  
  28. Const
  29.    DHelpKey = #187;                     {Alter these keys if desired.       }
  30.    DHelpStr:string[2] = 'F1';           {Note: to disable these keys, set   }
  31.    DToggleKey = #32;                    {      appropriate flags in Var D.   }
  32.    DToggleStr: string[5] = 'Space';
  33.    DZoomKey = #172;
  34. {$IFDEF DIRFULL}
  35.    DZoomStr: string[5] = 'Alt-Z';
  36.    DJumpParentKey = #176;
  37.    DJumpParentStr: string[5] = 'Alt-B';
  38.    DChangeDirKey = #174;
  39.    DChangeDirStr: string[5] = 'Alt-C';
  40.    DSortOrderKey = #152;
  41.    DSortOrderStr: string[5] = 'Alt-O';
  42.    DSortSizeKey = #159;
  43.    DSortSizeStr: string[5] = 'Alt-S';
  44.    DSortNameKey = #177;
  45.    DSortNameStr: string[5] = 'Alt-N';
  46.    DSortExtKey = #146;
  47.    DSortExtStr: string[5] = 'Alt-E';
  48.    DSortTimeKey = #148;
  49.    DSortTimeStr: string[5] = 'Alt-T';
  50.    DSortDOSKey = #160;
  51.    DSortDOSStr: string[5] = 'Alt-D';
  52.    DSortDos  = 1;
  53.    DSortName = 2;
  54.    DSortExt  = 3;
  55.    DSortSize = 4;
  56.    DSortTime = 5;
  57.    Ascending = 1;
  58.    Descending = 2;
  59. {$ENDIF}
  60.  
  61. Type
  62.    DirDisplay = record
  63.                      TopX       : byte;
  64.                      TopY       : Byte;
  65.                      Rows       : byte;
  66.                      Attrib     : byte;
  67.                      BoxType    : byte;
  68.                      BoxFCol    : byte;
  69.                      BoxBCol    : byte;
  70.                      KeyFCol    : byte;
  71.                      BacCol     : byte;
  72.                      NorFCol    : byte;
  73.                      DirFCol    : byte;
  74.                      HiFCol     : byte;
  75.                      HiBCol     : byte;
  76.                      AllowEsc   : boolean;
  77.                      ShowDetails: boolean;
  78.                      Colswide   : byte;
  79.                      DisplayInfo: boolean;
  80.                      RestoreScreen : boolean;
  81.                      AllowHelp     : boolean;
  82.                      AllowToggle   : boolean;
  83.                      AllowZoom     : boolean;
  84.                      ZoomLine      : byte;
  85.                      AllowSort     : boolean;
  86.                      InitSort      : byte;
  87.                      Asc           : byte;
  88.                      AllowCD       : boolean;
  89.                      SelectDir     : boolean;
  90.                      AllowInput    : boolean;
  91.                  end;
  92.  
  93. Var
  94.    DTTT : DirDisplay;
  95.    NoMemory : boolean;
  96.  
  97. Function Display_Directory(DIRFULLFileName: StrScreen;var Retcode:integer): StrScreen;
  98. Procedure Default_Settings;
  99.  
  100. IMPLEMENTATION
  101.  
  102.   
  103. Procedure Default_Settings;
  104. begin
  105.     With  DTTT  do
  106.     begin
  107.         TopX    := 0;
  108.         TopY    := 0;
  109.         Rows    := 0;
  110.         AllowEsc := true;
  111.         Attrib := Readonly + Directory + Archive;
  112.         BoxType := 1;
  113.         ShowDetails := true;
  114.         ColsWide := 5;
  115. {$IFDEF DIRFULL}
  116.         DisplayInfo := true;
  117.         AllowHelp := true;
  118.         AllowZoom   := true;
  119.         ZoomLine := 25;
  120.         AllowSort := true;
  121.         InitSort := DSortDOS;     {sort in DOS order}
  122.         AllowInput := True;
  123. {$ELSE}
  124.         DisplayInfo := false;
  125. {$ENDIF}
  126.         AllowCD := true;
  127.         SelectDir := false;
  128.         RestoreSCreen := true;
  129.         AllowToggle := true;
  130.         Asc := 1;
  131.         If BaseOfScreen = $b000 then
  132.         begin
  133.             BoxFCol := white;
  134.             BoxBCol := black;
  135.             KeyFCol := white;
  136.             BacCol := black;
  137.             NorFCol := white;
  138.             DirFCol := lightgray;
  139.             HiFcol := black;
  140.             HiBcol := lightgray
  141.         end
  142.         else
  143.         begin
  144.             BoxFCol := lightgray;
  145.             BoxBCol := blue;
  146.             KeyFCol := yellow;
  147.             BacCol := black;
  148.             NorFCol := white;
  149.             DirFCol := yellow;
  150.             HiFcol := black;
  151.             HiBcol := cyan;
  152.         end;
  153.     end; {with}
  154. end;
  155.  
  156.  
  157.  
  158. Function Display_Directory( DIRFULLFilename: StrScreen; var Retcode : integer): StrScreen;
  159. {
  160.               X1                                    X2
  161.      Y1 >      _____________________________________
  162.               |                                     | >
  163.               |                                     | >  Infodepth
  164.               |                                     | >
  165.      Y2 >     |_____________________________________| >
  166.               |                                     |
  167.               |                                     |
  168.               |                                     |
  169.               |                                     |
  170.               |                                     |
  171.               |                                     |
  172.      Y3 >     |_____________________________________|
  173.  
  174.  
  175.           Retcodes >    0  -  filechosen
  176.                         1  -  user escaped
  177.                         2  -  not enough memory
  178.                         3  -  no files matching
  179.                         99 -  unexpected error
  180.  
  181. }
  182. Type
  183.   FRptr = ^FR;
  184.   FR = record
  185.             Name : string[8];
  186.             Ext  : string[3];
  187.             Size : longint;
  188.             Time : longint;
  189.             Attr : byte;
  190.             Fn : integer;
  191.             PrevFR: FRptr;
  192.             NextFR : FRptr;
  193.        end;
  194.  
  195. const
  196.   OKCode = 0;           {ret codes}
  197.   EscCode = 1;
  198.   MemCode = 2;
  199.   NofilesCode = 3;
  200.   UnKnownCode = 99;
  201.   InfoDepth = 4;        {no of lines in information box, i.e.Y1 to Y2}
  202.   ReadMsg = 'Reading files';
  203.   SortMsg = 'Sorting files';
  204.   NoneMsg = 'No files ... ';
  205. var
  206.   X1,X2,Y1,Y2,Y3,R,Y3_Unzoomed : byte;{box dimensions}
  207.   StartDir : StrScreen;      {default directory}
  208.   ColumnsWide : byte;
  209.   TopFn : integer;           {file number of top file in the display}
  210.   BotFn : integer;           {file number of bottom file in the display}
  211.   HiFn  : integer;           {file number of hilighted file}
  212.   Zoomed: boolean;           {is file display extended to bottom of screen}
  213.   ShowingDetails : boolean;
  214.   PathName : StrScreen;      {the path section of filename}
  215.   FileMask : StrScreen;
  216.   FirstFile : FRptr;
  217.   List_End : FRptr;
  218.   ChosenFile: strscreen;
  219.   TotalFiles: word;
  220.   TotalDirs : word;
  221.   TotalBytes: LongInt;
  222.   Ftemp : FRPtr;
  223.   HeapTop : pointer;
  224.   DirTop : pointer;
  225.   Scrn : pointer;
  226.   CursRec : array[1..4] of byte;
  227.   SortOrder : byte;               {1-DOS, 2-Name, 3-Ext, 4-Size, 5-Time}
  228.   SortAsc : boolean;
  229.  
  230.     Function Subdirectory(B : byte):boolean;
  231.     begin
  232.         Subdirectory := ((B and Directory) = Directory);
  233.     end;
  234.  
  235.     Function FileAttribs(B:byte):StrScreen;
  236.     var
  237.       S : StrScreen;
  238.     begin
  239.         S := '    ';
  240.         If ((B and ReadOnly) = Readonly) then
  241.            S[1] := 'R';
  242.         If ((B and Hidden) = Hidden) then
  243.            S[2] := 'H';
  244.         If ((B and SysFile) = SysFile) then
  245.            S[3] := 'S';
  246.         If ((B and Archive) = Archive) then
  247.            S[4] := 'A';
  248.         FileAttribs := S;
  249.      end;
  250.  
  251.      Function LongFileDesc(F:FRptr):StrScreen;
  252.      var
  253.        DT :datetime;
  254.        S  : StrScreen;
  255.      begin
  256.          If ShowingDetails then
  257.          begin
  258.              with F^ do
  259.              begin
  260.                  UnPackTime(Time,DT);
  261.                  With DT do
  262.                  begin
  263.                      If Ext = '' then
  264.                         S := Padleft(Name,12,' ')
  265.                      else
  266.                         S :=  Padleft(Name+'.'+Ext,12,' ');                 {start with name}
  267.                      If Subdirectory(Attr) then                  {add file size}
  268.                         S := S + Padright('<DIR>',8,' ')
  269.                      else
  270.                         S := S + Padright(Int_to_Str(Size),8,' ');
  271.                      S := S + '    ';
  272.                      Case Month of                               {add month}
  273.                      1 : S := S + 'Jan ';
  274.                      2 : S := S + 'Feb ';
  275.                      3 : S := S + 'Mar ';
  276.                      4 : S := S + 'Apr ';
  277.                      5 : S := S + 'May ';
  278.                      6 : S := S + 'Jun ';
  279.                      7 : S := S + 'Jul ';
  280.                      8 : S := S + 'Aug ';
  281.                      9 : S := S + 'Sep ';
  282.                      10: S := S + 'Oct ';
  283.                      11: S := S + 'Nov ';
  284.                      12: S := S + 'Dec ';
  285.                      end;
  286.                      S :=   S                                   {add the day,year}
  287.                           + Padright(Int_to_Str(Day),2,'0')
  288.                           + ','
  289.                           + Int_to_Str(Year)
  290.                           + '    ';
  291.                      If Hour > 12 then                          {add a/p time}
  292.                         S :=  S
  293.                              +Padright(Int_to_Str(Hour-12),2,' ')
  294.                              +':'
  295.                              +Padright(Int_to_Str(Min),2,'0')
  296.                              +'p'
  297.                      else
  298.                         S :=  S
  299.                               +Padright(Int_to_Str(Hour),2,' ')
  300.                               +':'
  301.                               +Padright(Int_to_Str(Min),2,'0')
  302.                               +'a';
  303.                         S := S + '  '+FileAttribs(Attr);
  304.                  end;   {with DT}
  305.              end; {with F^}
  306.          end
  307.          else    {not one column}
  308.           If F^.Ext = '' then
  309.              S := Padleft(F^.Name,12,' ')
  310.           else
  311.              S := Padleft(F^.Name+'.'+F^.Ext,12,' ');
  312.          LongFileDesc := S;
  313.      end;
  314.  
  315.     Function PathSlash(S : StrScreen):StrScreen;
  316.     begin
  317.         If S[length(S)] <> '\' then
  318.            S := S + '\';
  319.         PathSlash := S;
  320.     end;  {Sub Func PathSlash}
  321.  
  322.     Function PathNoSlash(S : StrScreen):StrScreen;
  323.     begin
  324.         If S[length(S)] = '\' then
  325.            Delete(S,length(S),1);
  326.         PathNoSlash := S;
  327.     end;  {Sub Func PathSlash}
  328.  
  329.     Function PathParent(S : StrScreen):StrScreen;
  330.     var P1 : byte;
  331.     begin
  332.         S := PathNoSlash(S);
  333.         P1 := LastPos('\',S);
  334.         PathParent := copy(S,1,P1);
  335.     end;
  336.  
  337.     Function PathChild(S : StrScreen):StrScreen;
  338.     begin
  339.         PathChild := PathSlash(PathName + S);
  340.     end;
  341.  
  342.     Procedure Extract_Path_Mask;
  343.     var P1,P2 : byte;
  344.     begin
  345.         P1 := LastPos('\',DIRFULLFileName);
  346.         P2 := Pos(':',DIRFULLFilename);
  347.         If (P1 = 0) and (P2 = 0) then
  348.         begin
  349.             FileMask := DIRFULLFileName;
  350.             PathName := PathSlash(StartDir);
  351.             exit;
  352.         end;
  353.         If P1 = length(DIRFULLFileName) then
  354.         begin
  355.             FileMask := '*.*';
  356.             PathName := DIRFULLFileName;
  357.             exit;
  358.         end;
  359.         If (P1 = 0) and (P2 = 2) then   { x:filename.ext}
  360.         begin
  361.            Filemask := copy(DIRFULLFileName,3,length(DIRFULLFileName));
  362.            {$I-}
  363.            GetDir(ord(upcase(DIRFULLFileName[1]))-64,PathName);
  364.            {$I-}
  365.            If IOResult <> 0 then
  366.               PathName := PathSlash(StartDir)
  367.            else
  368.               PathName := PathSlash(PathName);
  369.            exit;
  370.         end;
  371.         Filemask := copy(DIRFULLFileName,succ(P1),12);
  372.         PathName := copy(DIRFULLFileName,1,P1);
  373.     end;  {Extract_Path_Mask}
  374.  
  375.     Procedure LoadFiles(Mask:StrScreen;Attrib:byte);
  376.     var
  377.       Finfo : SearchRec;
  378.       Recsize : word;
  379.  
  380.       Procedure PushOnHeap(var F:FrPtr);
  381.       var P : byte;
  382.       begin
  383.           with F^ do
  384.           begin
  385.               Attr := Finfo.Attr;
  386.               Time := Finfo.Time;
  387.               Size := Finfo.Size;
  388.               If FInfo.Name = '..' then
  389.               begin
  390.                   Name := '..';
  391.                   Ext := '';
  392.               end
  393.               else
  394.               begin
  395.                   P := pos('.',Finfo.Name);
  396.                   If P = 0 then
  397.                   begin
  398.                       Name := Finfo.Name;
  399.                       Ext := '';
  400.                  end
  401.                  else
  402.                  begin
  403.                      Name := copy(FInfo.Name,1, pred(P));
  404.                      Ext := copy(Finfo.Name,succ(P),3);
  405.                  end;
  406.               end;
  407.               Fn := succ(TotalFiles);
  408.               NextFR := nil;
  409.               PrevFr := nil;
  410.               TotalBytes := TotalBytes + Size;
  411.           end;
  412.           Inc(TotalFiles);
  413.           If Finfo.Attr = Directory then
  414.              Inc(TotalDirs);
  415.       end;   {sub sub proc TransferFileToHeap}
  416.  
  417.       Procedure AllocHeap;
  418.       begin
  419.           If ( (Attrib = Directory) and (FInfo.Attr <> Directory) ) then
  420.              exit;   {if only looking for directory entries}
  421.           If (Finfo.Name <> '.') and (DosError = 0) then
  422.           begin
  423.               If (TotalFiles = 0) then
  424.               begin
  425.                   PushOnHeap(FirstFile);
  426.                   FirstFile^.PrevFR := nil;
  427.                   Ftemp :=  FirstFile;
  428.                   List_End := FirstFile;
  429.               end
  430.               else
  431.               begin
  432.                   GetMem(Ftemp^.NextFR,Recsize);
  433.                   PushOnHeap(FTemp^.NextFr);
  434.                   FTemp := Ftemp^.NextFR;
  435.                   FTemp^.PrevFR := List_End;
  436.                   List_End := Ftemp;
  437.               end; {If TotalFiles = 0}
  438.          end; { If name <> '.'}
  439.       end;
  440.  
  441.     begin
  442.         RecSize := Sizeof(FirstFile^);
  443.         If MaxAvail < 2*Recsize then
  444.         begin
  445.             NoMemory := true;
  446.             exit;
  447.         end;
  448.         Fastwrite(X1+2,Y2+1,attr(DTTT.NorFcol+blink,DTTT.BacCol),ReadMsg);
  449.         FindFirst(PathName+Mask,Attrib,Finfo);
  450.         If DosError <> 0 then
  451.            exit;
  452.         If TotalFiles = 0 then
  453.         begin
  454.            GetMem(FirstFile,RecSize);
  455.            GetMem(List_End,RecSize);
  456.         end;
  457.         AllocHeap;
  458.         While (DosError = 0) and (NoMemory = false) do
  459.         begin
  460.             If MaxAvail < RecSize then
  461.                NoMemory := true
  462.             else
  463.             begin
  464.                 FindNext(Finfo);
  465.                 AllocHeap;
  466.             end; {If MaxAvail}
  467.         end; {while}
  468.     end; {Sub Proc Loadfiles}
  469.  
  470.     Procedure Calculate_Box_Dimensions;
  471.     var
  472.       Boxwidth : byte;
  473.     begin
  474.         If ShowingDetails then
  475.            Boxwidth := 54
  476.         else
  477.            Boxwidth := succ(DTTT.Colswide*14);
  478.         with DTTT do
  479.         begin
  480.             If (TopX < 1) or (TopX > 80) then
  481.                X1 :=  (80 - Boxwidth) div 2
  482.             else
  483.             begin
  484.                If TopX <= (80 - Boxwidth) then
  485.                   X1 := TopX
  486.                else                               {move box left until it fits}
  487.                   X1 := 80 - Boxwidth;
  488.             end;
  489.             X2 := X1 + Boxwidth;
  490.             If Rows in [1..23] then
  491.                R := Rows
  492.             else
  493.                R := 8;
  494.             If (TopY < 1) or (TopY > DisplayLines - 2) then
  495.                Y1 := 5
  496.             else
  497.                Y1 := TopY;
  498.             If not DisplayInfo then
  499.                Y2 := Y1
  500.             else
  501.             begin
  502.                 If Y1 + InfoDepth < DisplayLines - 2 then
  503.                    Y2 := Y1 + InfoDepth
  504.                 else                               {no room for info}
  505.                    Y2 := Y1;
  506.             end;
  507.             Y3 := Y2 + succ(R);
  508.             If Y3 > DisplayLines then
  509.             begin
  510.                Y3 := DisplayLines;
  511.                If Y2 <> Y1 then
  512.                begin
  513.                    Y2 := Y3 - succ(R);
  514.                    Y1 := Y2 - InfoDepth;
  515.                end
  516.                else
  517.                begin
  518.                    Y2 := Y3 - succ(R);
  519.                    Y1 := Y2;
  520.                end;
  521.             end;
  522.         end;
  523.     end;  {sub proc Calculate_Box_Dimensions}
  524.  
  525.     Procedure Display_Box;
  526.     var
  527.       LChar,Rchar : char;
  528.       Col,
  529.       I : integer;
  530.     begin
  531.         with DTTT do
  532.         begin
  533.             If Y2 = Y1 then
  534.                ClearText(X1,Y1,X2,Y3,NorFCol,Baccol)
  535.             else
  536.             begin
  537.                 ClearText(X1,Y1,X2,pred(Y2),BoxFCol,BoxBcol);
  538.                 ClearText(X1,Y2,X2,Y3,NorFCol,Baccol);
  539.             end;
  540.             Col := attr(BoxFcol,BoxBCol);
  541.             If (BoxType in [5..9]) then
  542.             begin
  543.                 Box(X1,Y1,X2,Y3,BoxFcol,BoxBcol,Boxtype-5);
  544.                 If (X2 < 80) and (Y3 < DisplayLines) then
  545.                 begin
  546.                     For I := succ(Y1) to succ(Y3) do
  547.                         Fastwrite(succ(X2),I,ShadColor,chr(219));
  548.                     Fastwrite(succ(X1),succ(Y3),ShadColor,replicate(X2-X1,chr(219)));
  549.                 end;
  550.             end
  551.             else
  552.                Box(X1,Y1,X2,Y3,BoxFcol,BoxBcol,Boxtype);
  553.             If Y2 > Y1 then
  554.             begin
  555.                 Horizline(succ(X1),pred(X2),Y2,BoxFCol,BoxBcol,Boxtype);
  556.                 Case Boxtype of
  557.                 1,6 : begin
  558.                           LChar := chr(195);
  559.                           RChar := chr(180);
  560.                       end;
  561.                 2,7 : begin
  562.                           LChar := chr(204);
  563.                           RChar := chr(185);
  564.                       end;
  565.                 3,8 : begin
  566.                           LChar := chr(199);
  567.                           RChar := chr(182);
  568.                       end;
  569.                 4,9 : begin
  570.                           LChar := chr(181);
  571.                           RChar := chr(198);
  572.                       end;
  573.                 else      Lchar := ' ';
  574.                           Rchar := ' ';
  575.                 end;  {case}
  576.                 Fastwrite(X1,Y2,Col,Lchar);
  577.                 Fastwrite(X2,Y2,Col,Rchar);
  578.             end;
  579.         end;
  580.     end;  {sub proc display box}
  581.  
  582.     Procedure DisplayPath;
  583.     var
  584.        L : byte;
  585.        Y : byte;
  586.        P : StrScreen;
  587.     begin
  588.         P := Pathname+Filemask;
  589.         L := length(P);
  590.         If Y2 = Y1 then
  591.         begin
  592.            Y := Y1;
  593.            If L > (X2-X1-2) then
  594.               P := chr(17)+copy(P,L-(X2-X1)+4,L);
  595.         end
  596.         else
  597.         begin
  598.            Y := Y1 + 2;
  599.            If L > (X2-X1-2) then
  600.               P := chr(17)+copy(P,L-(X2-X1-1)+4,L);
  601.         end;
  602.         Fastwrite(X1+2,Y,attr(DTTT.BoxFcol,DTTT.BoxBCol),P);
  603.     end;  {sub Proc DisplayPath}
  604.  
  605.  
  606.     Procedure FillInfo;
  607.     var
  608.       TB,Di : StrScreen;
  609.       C,H,L  : byte;
  610.     begin
  611.         with DTTT do
  612.         begin
  613.             C := attr(BoxFCol,BoxBCol);
  614.             H := attr(KeyFcol,BoxBCol);
  615.             If (Y2 = Y1) then
  616.             begin
  617.                 DisplayPath;
  618.                 exit;
  619.             end;
  620. {$IFDEF DIRFULL}
  621.             If  (ColumnsWide < 3 ) and (ShowingDetails = false) then
  622.             begin
  623.                 DisplayPath;
  624.                 Fastwrite(X1+2,Y1+1,H,chr(17)+char(217));
  625.                 Fastwrite(X1+5,Y1+1,C,'Select');
  626.                 Fastwrite(X1+2,Y1+3,C,'Files: ');
  627.                 Fastwrite(X1+9,Y1+3,C,Int_To_Str(TotalFiles-TotalDirs));
  628.                 exit;
  629.             end;
  630.             ClearText(succ(X1),Succ(Y1),pred(X2),Pred(Y2),BoxFcol,BoxBCol);
  631.             Fastwrite(X1 + 2,Y1 + 3,C,'Matching files: ');
  632.             Fastwrite(X1 + 18,Y1 + 3,C,Int_To_Str(TotalFiles-TotalDirs));
  633.             TB := 'Total bytes: '+Int_To_Str(TotalBytes);
  634.             Fastwrite(X2 -length(TB) - 1,Y1 + 3,C,TB);
  635.             If AllowHelp then
  636.             begin
  637.                 Fastwrite(X1+2,Y1+1,H,DHelpStr);    {Prompt at left}
  638.                 Fastwrite(X1+3+length(DHelpStr),Y1+1,C,'Help');
  639.             end;
  640.             L := pred(X1)
  641.                + ((X2-X1) div 2)
  642.                - (length(DToggleStr)+ 7) div 2;     {next prompt in center}
  643.             Fastwrite(L,Y1+1,H,chr(17)+char(217));
  644.             L := L + 3;
  645.             Fastwrite(L,Y1+1,C,'Select');
  646.             If AllowToggle then
  647.             begin
  648.                 L := X2 - length(DToggleStr) - 8;   {right justified}
  649.                 Fastwrite(L,Y1+1,H,DToggleStr);
  650.                 L := L + 1 + length(DToggleStr);
  651.                 Fastwrite(L,Y1+1,C,'Toggle');
  652.             end;
  653.         end;
  654.         DisplayPath;
  655. {$ELSE}
  656.        end;
  657. {$ENDIF}
  658.     end;  {sub proc Fillinfo}
  659.  
  660.     Function FilePointer(Fn:word): FRptr;
  661.     {MODIFY to go from current pointer - for speed}
  662.     var
  663.       P : FRptr;
  664.       I : integer;
  665.     begin
  666.         If  SortAsc then
  667.         begin
  668.             P := FirstFile;
  669.             If Fn > 1 then
  670.                For I := 2 to Fn do
  671.                    P := P^.NextFr;
  672.         end
  673.         else {Descending}
  674.         begin
  675.             P := List_End;
  676.             If Fn > 1 then
  677.                For I := 2 to Fn do
  678.                    P := P^.PrevFr;
  679.         end;
  680.         FilePointer := P;
  681.     end;  {sub proc filepointer}
  682.  
  683.     Function Y_Coord(Fn : word):byte;
  684.     begin
  685.          Y_Coord := Succ(Y2) + ((Fn-TopFn) DIV ColumnsWide);
  686.     end;
  687.  
  688.     Function X_Coord(Fn : word):byte;
  689.     begin
  690.            X_Coord := succ(X1) + 14*((Fn-TopFn) MOD Columnswide);
  691.     end;
  692.  
  693.     Function TopLine:Boolean;
  694.     begin
  695.           TopLine := (HiFn <= ColumnsWide);
  696.     end;
  697.  
  698.     Function BottomLine:Boolean;
  699.     begin
  700.           BottomLine := (HiFn + ColumnsWide > TotalFiles);
  701.     end;
  702.  
  703.     Function FirstColumn:boolean;
  704.     begin
  705.            If Columnswide = 1 then
  706.               FirstColumn := true
  707.            else
  708.               FirstColumn := (HiFn MOD ColumnsWide = 1);
  709.     end;
  710.  
  711.     Function LastColumn:boolean;
  712.     begin
  713.            LastColumn := (HiFn MOD ColumnsWide = 0);
  714.     end;
  715.  
  716.     Procedure RecalcTopFn;
  717.     begin
  718.         If ColumnsWide = 1 then
  719.            TopFn := succ(BotFn -R)
  720.         else
  721.             TopFn :=  Succ(   BotFn
  722.                             - pred(R)*ColumnsWide
  723.                             - BotFn MOD ColumnsWide
  724.                           );
  725.     end;
  726.  
  727.     Procedure RecalcBotFn;
  728.     begin
  729.         BotFn := pred( TopFn + ColumnsWide*R);
  730.         If BotFn > TotalFiles then
  731.            BotFn := TotalFiles;
  732.     end;
  733.  
  734.     Procedure LolightFile(Fn:word);
  735.     var
  736.       C : byte;
  737.       F : FRptr;
  738.     begin
  739.         If (Fn < TopFn) or (Fn > BotFn ) then
  740.            exit;    {file not in display area}
  741.         F := Filepointer(Fn);
  742.         If Subdirectory(F^.Attr) then
  743.            C := attr(DTTT.DirFcol,DTTT.BacCol)
  744.         else
  745.            C := attr(DTTT.NorFCol,DTTT.BacCol);
  746.         Fastwrite(X_Coord(Fn),
  747.                   Y_Coord(Fn),
  748.                   C,
  749.                   ' '+LongFileDesc(F)+' ');
  750.     end;
  751.  
  752.     Procedure HilightFile(Fn:word);
  753.     var
  754.       F : FRptr;
  755.     begin
  756.         If (Fn < TopFn) or (Fn > BotFn) then
  757.            exit;    {file not in display area}
  758.         F := Filepointer(Fn);
  759.         Fastwrite(X_Coord(Fn),
  760.                   Y_Coord(Fn),
  761.                   attr(DTTT.HiFcol,DTTT.HiBCol),
  762.                   +' '+LongFileDesc(F)+' ')
  763.     end;
  764.  
  765.     Function File_name(Fn : word):StrScreen;
  766.     var
  767.        F : FRPtr;
  768.        Fname : strscreen;
  769.     begin
  770.         F := FilePointer(Fn);
  771.         Fname := F^.Name;
  772.         If F^.Ext <> '' then
  773.            Fname := Fname+'.'+F^.Ext;
  774.         File_Name := Fname;
  775.     end;   {Sub Funct File_name}
  776.  
  777.     Procedure DisplayFiles;
  778.     var
  779.       I : integer;
  780.     begin
  781.         If (Columnswide > 1) and (BotFn = TotalFiles) then    {clear line}
  782.            ClearText(succ(X1),pred(Y3),Pred(X2),pred(Y3),DTTT.NorFcol,DTTT.BacCol);
  783.         For I := TopFn to BotFn do
  784.             If (I <> HiFn) and (I <= TotalFiles) then
  785.                LolightFile(I);
  786.         HiLightFile(HiFn);
  787.     end; {sub proc DisplayFiles}
  788.  
  789.     Procedure Scroll_Down;
  790.     begin
  791.         TopFn := TopFn + Columnswide;
  792.         RecalcBotFn;
  793.         DisplayFiles;
  794.     end; {scroll_down}
  795.  
  796.     Procedure Scroll_Up;
  797.     begin
  798.         TopFn := TopFn - Columnswide;
  799.         RecalcBotFn;
  800.         DisplayFiles;
  801.     end; {scroll_up}
  802.  
  803.     Procedure Scroll_Top;
  804.     begin
  805.         TopFn := 1;
  806.         RecalcBotFn;
  807.         HiFn := 1;
  808.         DisplayFiles;
  809.     end; {scroll_Home}
  810.  
  811.     Procedure Scroll_Bottom;
  812.     begin
  813.         TopFn := succ(TotalFiles - R);
  814.         BotFn := TotalFiles;
  815.         HiFn := TotalFiles;
  816.         DisplayFiles;
  817.     end; {scroll_Home}
  818.  
  819.  
  820. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\    SORTING   \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  821. {$IFDEF DIRFULL}
  822.  
  823. Function Larger(Ptr1,Ptr2: FRptr) : boolean;
  824. var
  825.    N1,N2 : string[8];
  826.    E1,E2 : string[8];
  827. begin
  828.     Case SortOrder of
  829.     DSortDos   : Larger := (Ptr1^.Fn > Ptr2^.Fn);
  830.     DSortNAME  : If Ptr1^.Name = Ptr2^.Name then
  831.                     Larger := Ptr1^.Ext > Ptr2^.Ext
  832.                  else
  833.                     Larger := Ptr1^.Name > Ptr2^.Name;
  834.     DSortEXT   : If Ptr1^.Ext = Ptr2^.Ext then
  835.                     Larger := Ptr1^.Name > Ptr2^.Name
  836.                  else
  837.                     Larger := Ptr1^.Ext > Ptr2^.Ext;
  838.     DSortSIZE  : Larger := (Ptr1^.Size > Ptr2^.Size);
  839.     DSortTIME  : Larger := (Ptr1^.Time > Ptr2^.Time);
  840.     else Larger := false;
  841.     end; {Case}
  842. end; {suc proc larger}
  843.  
  844. Procedure SwapIt(var Ptr1,Ptr2: FRPtr);
  845. var
  846.    Temp : FR;
  847.    Size : integer;
  848. begin
  849.     Temp := Ptr2^;
  850.     Size := sizeof(Temp) - 8;
  851.     Move(Ptr1^,Ptr2^,Size);
  852.     Move(Temp,Ptr1^,Size);
  853. end;  {sub proc Swap}
  854.  
  855. Procedure ShellSort;
  856. var
  857.    I,J,Delta : longint;
  858.    Swapped : boolean;
  859.    Ptr1,Ptr2 : FRPtr;
  860.  
  861. begin
  862.     Delta := TotalFiles div 2;
  863.     repeat
  864.          Repeat
  865.               Swapped := false;
  866.               Ptr1 := FirstFile;
  867.               Ptr2 := Ptr1;
  868.               For I := 1 to Delta do
  869.                   Ptr2 := Ptr2^.NextFr;
  870.               For I := 1 to TotalFiles - Delta do
  871.               begin
  872.                   If I > 1 then
  873.                   begin
  874.                       Ptr1 := Ptr1^.NextFr;
  875.                       Ptr2 := Ptr2^.NextFr;
  876.                   end;
  877.                   If Larger(Ptr1,Ptr2) then
  878.                   begin
  879.                       SwapIt(Ptr1,Ptr2);
  880.                       Swapped := true;
  881.                   end;
  882.               end;
  883.          Until (not Swapped);
  884.          Delta := delta div 2;
  885.     Until Delta = 0;
  886. end;
  887.  
  888.                 Procedure ReSort;
  889.                 begin
  890.                     ClearText(succ(X1),Succ(Y2),pred(X2),pred(Y3),DTTT.NorFcol,DTTT.BacCol);
  891.                     Fastwrite(X1 + 2,succ(Y2),attr(DTTT.NorFcol+blink,DTTT.BacCol),SortMsg);
  892.                     ShellSort;
  893.                     TopFn := 1;
  894.                     HiFn := 1;
  895.                     RecalcBotFn;
  896.                     DisplayFiles;
  897.                 end;
  898. {$ENDIF}
  899.  
  900.     Procedure DisplayNewDirectory;
  901.     var A : byte;
  902.     begin
  903.         A := DTTT.attrib and (AnyFile - VolumeID);
  904.         Display_Box;
  905.         TotalFiles := 0;
  906.         TotalBytes := 0;
  907.         TotalDirs  := 0;
  908.         Mark(DirTop);
  909.         If DTTT.AllowCd or DTTT.SelectDir then
  910.         begin
  911.             If Subdirectory(A) then
  912.             begin
  913.                  LoadFiles('*.*',Directory);                {load directory details first}
  914.                  Loadfiles(Filemask,A and (anyfile - Directory));  {then load other files with mask}
  915.             end
  916.             else
  917.                  LoadFiles(Filemask,A and (Anyfile - Directory));
  918.         end
  919.         else                  {automatically removed directory type files}
  920.              LoadFiles(Filemask,A and (anyfile - Directory));
  921.         FillInfo;
  922. {$IFDEF DIRFULL}
  923.         If SortOrder <> DSortDOS then
  924.            ShellSort;
  925. {$ENDIF}
  926.         If TotalFiles = 0 then
  927.            Fastwrite(X1+2,Y2+1,attr(DTTT.NorFcol,DTTT.BacCol),NoneMsg)
  928.         else
  929.            Scroll_Top;
  930.     end;  {sub proc DisplayNewDirectory}
  931.  
  932. {$IFDEF DIRFULL}
  933.     Procedure ShowHelpScreen;
  934.     const
  935.         width = 55;
  936.         depth = 14;
  937.     var
  938.       Str : StrScreen;
  939.       S  : word;
  940.       Sc : pointer;
  941.       X,Y : byte;
  942.       ChH : char;
  943.     begin
  944.         If X1 + width > 80 then
  945.            X := pred((80 - width) div 2)
  946.         else
  947.            X := X1;
  948.         If Y1 + Depth > DisplayLines then
  949.            Y := pred((DisplayLines -Depth) div 2)
  950.         else
  951.            Y := Y1;
  952.         S := 160*DisplayLines;
  953.         If MaxAvail < S then
  954.            exit;
  955.         GetMem(Sc,S);
  956.         MoveFromScreen(Mem[BaseOfScreen:0],Sc^,S Div 2);
  957.         FBox(X,Y,pred(X+ width),pred(Y+Depth),DTTT.BoxFCol,DTTT.BoxBCol,1);
  958.         Case SortOrder of
  959.         DSortDos  : Str := ' DOS';
  960.         DSortName : Str := ' NAME';
  961.         DSortExt  : Str := ' EXT';
  962.         DSortSize : Str := ' SIZE';
  963.         DSortTime : Str := ' TIME';
  964.         end; {case}
  965.         If SortAsc then
  966.            Str := Str +' in ASCENDING order'
  967.         else
  968.            Str := Str +' in DESCENDING order';
  969.         If Zoomed then
  970.            Str := Str +' (Zoomed) '
  971.         else
  972.            Str := Str+' (not zoomed) ';
  973.         Str := ' Current: '+Str;
  974.         WriteBetween(X,X + Width,pred(Y)+depth,DTTT.KeyFCol,DTTT.BoxBCol,Str);
  975.         If DTTT.AllowSort then
  976.         begin
  977.             Fastwrite(X+4,Y+2,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortDOSStr);
  978.             Fastwrite(X+7+length(DSortDOSStr),Y+2,
  979.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  980.                       'sort in native DOS order');
  981.             Fastwrite(X+4,Y+3,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortNameStr);
  982.             Fastwrite(X+7+length(DSortNameStr),Y+3,
  983.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  984.                       'sort alphabetically by file Name');
  985.             Fastwrite(X+4,Y+4,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortExtStr);
  986.             Fastwrite(X+7+length(DSortExtStr),Y+4,
  987.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  988.                       'sort alphabetically by file Extension');
  989.             Fastwrite(X+4,Y+5,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortSizeStr);
  990.             Fastwrite(X+7+length(DSortSizeStr),Y+5,
  991.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  992.                       'sort by file Size');
  993.             Fastwrite(X+4,Y+6,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortTimeStr);
  994.             Fastwrite(X+7+length(DSortTimeStr),Y+6,
  995.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  996.                       'sort by date/Time of file');
  997.             Fastwrite(X+4,Y+7,attr(DTTT.KeyFCol,DTTT.BoxBCol),DSortOrderStr);
  998.             Fastwrite(X+7+length(DSortOrderStr),Y+7,
  999.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  1000.                       'sort in ascending or descending Order');
  1001.         end
  1002.         else
  1003.            WriteBetween(X,X+Width,Y+3,DTTT.BoxFCol,DTTT.BoxBCol,'SORTING DISABLED');
  1004.         If DTTT.AllowZoom then
  1005.         begin
  1006.             Fastwrite(X+4,Y+9,attr(DTTT.KeyFCol,DTTT.BoxBCol),DZoomStr);
  1007.             Fastwrite(X+7+length(DZoomStr),Y+9,
  1008.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  1009.                       'toggle long/short box size');
  1010.         end;
  1011.         If DTTT.AllowCD then
  1012.         begin
  1013.             Fastwrite(X+4,Y+11,attr(DTTT.KeyFCol,DTTT.BoxBCol),DChangeDirStr);
  1014.             Fastwrite(X+7+length(DChangeDirStr),Y+11,
  1015.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  1016.                       'change to new drive/directory');
  1017.             Fastwrite(X+4,Y+12,attr(DTTT.KeyFCol,DTTT.BoxBCol),DJumpParentSTr);
  1018.             Fastwrite(X+7+length(DJumpParentStr),Y+12,
  1019.                       attr(DTTT.BoxFCol,DTTT.BoxBCol),
  1020.                       'backup to parent directory');
  1021.         end;
  1022.         WriteBetween(X, X + Width, Y,
  1023.                      DTTT.BoxFCol + Blink, DTTT.BoxBCol,
  1024.                      ' press any key ... ');
  1025.  
  1026.         ChH := upcase(GetKey);
  1027.         MoveToScreen(Sc^,Mem[BaseOfScreen:0], S Div 2);
  1028.         FreeMem(Sc,S);
  1029.     end;
  1030.  
  1031.     Procedure PromptForDirectory;
  1032.     const
  1033.        width = 55;
  1034.     var
  1035.        S : word;
  1036.        Sc : pointer;
  1037.        X : byte;
  1038.        OldP,OldM,Strng : String;
  1039.     begin
  1040.         S := 160*DisplayLines;
  1041.         If MaxAvail < S then
  1042.            exit;
  1043.         OldP := Pathname;
  1044.         OldM := FileMask;
  1045.         GetMem(Sc,S);
  1046.         MoveFromScreen(Mem[BaseOfScreen:0],Sc^,S Div 2);    {SaveThescreen}
  1047.         If X1 + width > 80 then
  1048.            X := pred((80 - width) div 2)
  1049.         else
  1050.            X := X1;
  1051.         FBox(X,Y1,pred(X + width),Y1 + 2,DTTT.BoxFCol,DTTT.BoxBCol,2);
  1052.         WriteBetween(X,X+Width,Y1,DTTT.KeyFCol,DTTT.BoxBCol,'  Directory of Files  ');
  1053.         Strng := PathName+FileMask;
  1054.         Read_String_Upper(X+1,Y1+1,width - 2,'',0,Strng);
  1055.         MoveToScreen(Sc^,Mem[BaseOfScreen:0], S Div 2);
  1056.         FreeMem(Sc,S);
  1057.         If (R_Char <> #027) then
  1058.         begin
  1059.             DIRFULLFileName := Strng;
  1060.             Extract_Path_Mask;
  1061.             Release(DirTop);
  1062.             DisplayNewDirectory;
  1063.             If TotalFiles = 0 then   {re-read original directory}
  1064.             begin
  1065.                sound(800);delay(200);nosound;
  1066.                PathName := OldP;
  1067.                FileMask := OldM;
  1068.                Release(DirTop);
  1069.                DisplayNewDirectory;
  1070.             end;
  1071.         end;
  1072.     end;
  1073.  
  1074.     Function PromptForFilename(C:char):string;
  1075.     const
  1076.        width = 55;
  1077.     var
  1078.        S : word;
  1079.        Sc : pointer;
  1080.        X : byte;
  1081.        Strng : String;
  1082.        Msg : Strscreen;
  1083.     begin
  1084.         S := 160*DisplayLines;
  1085.         If MaxAvail < S then
  1086.            exit;
  1087.         GetMem(Sc,S);
  1088.         MoveFromScreen(Mem[BaseOfScreen:0],Sc^,S Div 2);    {SaveThescreen}
  1089.         If X1 + width > 80 then
  1090.            X := pred((80 - width) div 2)
  1091.         else
  1092.            X := X1;
  1093.         FBox(X,Y1,pred(X + width),Y1 + 2,DTTT.BoxFCol,DTTT.BoxBCol,2);
  1094.         If C = #0 then
  1095.         begin
  1096.            Msg := '  No files  - enter filename  ';
  1097.            Strng := '';
  1098.         end
  1099.         else
  1100.         begin
  1101.            Msg := '  Enter filename (or Esc)  ';
  1102.            Strng := C;
  1103.         end;
  1104.         WriteBetween(X,X+Width,Y1,DTTT.KeyFCol,DTTT.BoxBCol,Msg);
  1105.         Read_String_Upper(X+1,Y1+1,width-2,'',0,Strng);
  1106.         MoveToScreen(Sc^,Mem[BaseOfScreen:0], S Div 2);
  1107.         FreeMem(Sc,S);
  1108.         If (R_Char <> #027) then
  1109.             PromptForFilename := Strng
  1110.         else
  1111.             PromptForFilename := '';
  1112.     end;
  1113.  
  1114. {$ENDIF}
  1115.  
  1116. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  1117. {$IFDEF DIRFULL}
  1118.      Function No_Files_Found: integer;
  1119.      {returns 99 if user escaped
  1120.            or 0  if user enter a file
  1121.      }
  1122.      begin
  1123.  
  1124.          ChosenFile := PromptForFilename(#0);
  1125.          If ChosenFile = '' then
  1126.          begin
  1127.              No_Files_Found := 99;
  1128.              exit;
  1129.          end;
  1130.          If (pos('*',ChosenFile) > 0)
  1131.          or (pos('?',ChosenFile) > 0)
  1132.          or (ChosenFile[Length(ChosenFile)] = '\') then
  1133.          begin
  1134.              DIRFULLFileName := ChosenFile;
  1135.              Extract_Path_Mask;
  1136.              Release(DirTop);
  1137.              DisplayNewDirectory;
  1138.          end
  1139.          else
  1140.          begin
  1141.              If  (pos('\',ChosenFile) = 0)
  1142.              and (pos(':',ChosenFile) = 0) then
  1143.              begin
  1144.                  ChosenFile := PathName + ChosenFile;
  1145.                  No_Files_Found := 0;
  1146.                  exit;
  1147.              end;
  1148.          end;
  1149.          No_Files_Found := 1;
  1150.      end; {of func No_Files_Found}
  1151. {$ENDIF}
  1152.  
  1153.     Procedure Process_Keys;
  1154.     var
  1155.       ChD : char;
  1156.       Finished : Boolean;
  1157.     begin
  1158.         Finished := false;
  1159.         If TotalFiles = 0 then
  1160.         begin
  1161. {$IFDEF DIRFULL}
  1162.             Repeat
  1163.                  Case No_Files_Found of
  1164.                  0 : exit;  {user selected a file}
  1165.                  99: begin  {user escaped}
  1166.                          Retcode := NoFilesCode;
  1167.                          Exit;
  1168.                      end;
  1169.                  end; {case}
  1170.             until TotalFiles <> 0;
  1171. {$ELSE}
  1172.            Retcode := NoFilesCode;
  1173.            Exit;
  1174. {$ENDIF}
  1175.         end;
  1176.         Repeat
  1177.              ChD := upcase(GetKey);
  1178.              Case ChD of
  1179.              #129,                  {mouse down, down arrow}
  1180.              #208 :  If not BottomLine then
  1181.                      begin
  1182.                          LoLightFile(HiFn);
  1183.                          Hifn := HiFn + Columnswide;
  1184.                          If HiFn <= BotFn then
  1185.                             HiLightFile(HiFn)
  1186.                          else
  1187.                             Scroll_Down;
  1188.                      end;
  1189.              #128,                      {mouse up, up arrow}
  1190.              #200 : If not TopLine then
  1191.                     begin
  1192.                         LoLightFile(HiFn);
  1193.                         Hifn := HiFn - Columnswide;
  1194.                         If HiFn >= TopFn then
  1195.                            HiLightFile(HiFn)
  1196.                         else
  1197.                            Scroll_Up;
  1198.                     end;
  1199.              #205 : If HiFn < TotalFiles then  {right arrow}
  1200.                     begin
  1201.                         LolightFile(HiFn);
  1202.                         Inc(HiFn);
  1203.                         If HiFn > BotFn then
  1204.                            Scroll_Down
  1205.                         else
  1206.                            HiLightFile(HiFn);
  1207.                     end;
  1208.              #131 : If  (LastColumn = false) and (HiFn < BotFn) then  {mouse right}
  1209.                     begin
  1210.                         LolightFile(HiFn);
  1211.                         Inc(HiFn);
  1212.                         HiLightFile(HiFn);
  1213.                     end;
  1214.              #130 : If (FirstColumn = false) then   {mouse left}
  1215.                     begin
  1216.                        LolightFile(HiFn);
  1217.                        Dec(HiFn);
  1218.                        HiLightFile(HiFn);
  1219.                     end;
  1220.              #203 : If HiFn > 1 then {Left arrow}
  1221.                     begin
  1222.                         LolightFile(HiFn);
  1223.                         Dec(HiFn);
  1224.                         If HiFn < TopFn then
  1225.                            Scroll_Up
  1226.                         else
  1227.                            HiLightFile(HiFn);
  1228.                     end;
  1229.              #199 : If Columnswide = 1 then
  1230.                     begin
  1231.                         If TopFn = 1 then
  1232.                         begin
  1233.                             LoLightFile(HiFn);
  1234.                             HiFn := 1;
  1235.                              HiLightFile(HiFn);
  1236.                         end
  1237.                         else
  1238.                            Scroll_Top;
  1239.                     end
  1240.                     else  {multiple column}
  1241.                     begin
  1242.                         If not FirstColumn then   {home}
  1243.                         begin
  1244.                             LoLightFile(HiFn);
  1245.                             HiFn := HiFn - (pred(HiFn) mod ColumnsWide);
  1246.                             HiLightFile(HiFn);
  1247.                         end;
  1248.                     end;
  1249.              #207 : If ColumnsWide = 1  then   {end}
  1250.                     begin
  1251.                         If TotalFiles <= BotFn then
  1252.                         begin
  1253.                              LoLightFile(HiFn);
  1254.                              HiFn := TotalFiles;
  1255.                              HiLightFile(HiFn);
  1256.                         end
  1257.                         else
  1258.                            Scroll_Bottom;
  1259.                     end
  1260.                     else
  1261.                     begin
  1262.                         If not LastColumn then
  1263.                         begin
  1264.                             LoLightFile(HiFn);
  1265.                             HiFn := HiFn
  1266.                                   + Columnswide
  1267.                                   - HiFn mod ColumnsWide;
  1268.                             If HiFn > BotFn then
  1269.                                HiFn := BotFn;
  1270.                             HiLightFile(HiFn);
  1271.                         end;
  1272.                     end;
  1273.              #245 : If HiFn < TotalFiles then      {Ctrl End}
  1274.                     begin
  1275.                         If BotFn = TotalFiles then
  1276.                         begin
  1277.                              LoLightFile(HiFn);
  1278.                              HiFn := TotalFiles;
  1279.                              HiLightFile(HiFn);
  1280.                         end
  1281.                         else
  1282.                         begin
  1283.                            BotFn := TotalFiles;
  1284.                            RecalcTopFn;
  1285.                            HiFn := TotalFiles;
  1286.                            DisplayFiles;
  1287.                         end;
  1288.                     end;
  1289.              #201 : If HiFn > 1 then               {PgUp}
  1290.                     begin
  1291.                         If TopFn > 1 then
  1292.                         begin
  1293.                             TopFn := TopFn - R*ColumnsWide;
  1294.                             If TopFn < 1 then
  1295.                                TopFn := 1;
  1296.                         end;
  1297.                         RecalcBotFn;
  1298.                         HiFN := HiFn - R*ColumnsWide;
  1299.                         If HiFn < 1 then
  1300.                            HiFn := 1;
  1301.                         DisplayFiles;
  1302.                     end;
  1303.              #209 : If Hifn < TotalFiles then      {PgDn}
  1304.                     begin
  1305.                         If BotFn < TotalFiles then
  1306.                         begin
  1307.                             TopFn := TopFN + R*ColumnsWide;
  1308.                             BotFn := BotFn + R*ColumnsWide;
  1309.                             HiFn := HiFn + R*ColumnsWide;
  1310.                             If BotFn > TotalFiles then
  1311.                             begin
  1312.                                 BotFn := TotalFiles;
  1313.                                 RecalcTopFn;
  1314.                                 If  (HiFn < TopFn) then
  1315.                                     Repeat
  1316.                                         HiFn := HiFn + ColumnsWide;
  1317.                                     Until HiFN >= TopFN
  1318.                                 else
  1319.                                     If (HiFn > BotFn)  then
  1320.                                         HiFn := BotFn;
  1321.                             end;
  1322.                             DisplayFiles;
  1323.                         end
  1324.                         else     {Botfn is last file}
  1325.                         begin
  1326.                             LoLightFile(HiFn);
  1327.                             If BottomLine then
  1328.                                 HiFn := BotFn
  1329.                             else
  1330.                                 HiFn := HiFn + R*ColumnsWide;
  1331.                             If HiFn > BotFn then
  1332.                                HiFn := BotFn;
  1333.                             HiLightFile(HiFn);
  1334.                         end;
  1335.                     end;
  1336.              #247 : If HiFn > 1 then      {Ctrl Home}
  1337.                     begin
  1338.                         If TopFn = 1 then
  1339.                         begin
  1340.                              LoLightFile(HiFn);
  1341.                              HiFn := 1;
  1342.                              HiLightFile(HiFn);
  1343.                         end
  1344.                         else
  1345.                            Scroll_Top;
  1346.                     end;
  1347.        DTogglekey : If DTTT.AllowToggle then
  1348.                     begin
  1349.                         ShowingDetails := not ShowingDetails;
  1350.                         If Not ShowingDetails then
  1351.                            ColumnsWide := DTTT.ColsWide
  1352.                         else
  1353.                            Columnswide := 1;
  1354.                         MoveToScreen(Scrn^,mem[BaseofScreen:0],80*DisplayLines);
  1355.                         Calculate_Box_Dimensions;
  1356.                         If Zoomed then
  1357.                         begin
  1358.                             Y3 := DTTT.Zoomline;
  1359.                             R := pred(Y3 - Y2);
  1360.                         end;
  1361.                         TopFn := 0;
  1362.                         Repeat
  1363.                             If TopFN = 0 then
  1364.                                TopFn := 1
  1365.                             else
  1366.                                TopFn := TopFN + R*ColumnsWide;
  1367.                             BotFn := pred( TopFn + ColumnsWide*R);
  1368.                             If BotFn > TotalFiles then
  1369.                             begin
  1370.                                BotFn := TotalFiles;
  1371.                                If BotFn - pred(R*ColumnsWide) > 0 then
  1372.                                   TopFn := BotFN - pred(R*ColumnsWide);
  1373.                             end;
  1374.                         until ((HiFn >= TopFn) and (HiFn <= BotFn));
  1375.                         Display_Box;
  1376.                         FillInfo;
  1377.                         DisplayFiles;
  1378.                     end;
  1379. {$IFDEF DIRFULL}
  1380.          DZoomKey : If DTTT.AllowZoom then
  1381.                     begin
  1382.                         If Zoomed then
  1383.                         begin
  1384.                            MoveToScreen(Scrn^,mem[BaseofScreen:0],80*DisplayLines);
  1385.                             Zoomed := false;
  1386.                             Y3 := Y3_Unzoomed;
  1387.                             R := pred(Y3 - Y2);
  1388.                             RecalcBotFn;
  1389.                             If HiFn > BotFn then
  1390.                                HiFn := BotFn;
  1391.                             Display_Box;
  1392.                             FillInfo;
  1393.                             DisplayFiles;
  1394.                         end
  1395.                         else
  1396.                         begin
  1397.                             If (DTTT.ZoomLine > Y3) and (DTTT.ZoomLine <= DisplayLines) then
  1398.                             begin
  1399.                                 MoveToScreen(Scrn^,mem[BaseofScreen:0],80*DisplayLines);
  1400.                                 Zoomed := true;
  1401.                                 Y3 := DTTT.ZoomLine;
  1402.                                 R := pred(Y3 - Y2);
  1403.                                 RecalcBotFn;
  1404.                                 Display_Box;
  1405.                                 FillInfo;
  1406.                                 DisplayFiles;
  1407.                             end;
  1408.                         end;
  1409.                     end;
  1410.     DSortOrderKey : If DTTT.AllowSort then
  1411.                     begin
  1412.                         SortAsc := not SortAsc;
  1413.                         TopFn := 1;
  1414.                         HiFn := 1;
  1415.                         RecalcBotFn;
  1416.                         DisplayFiles;
  1417.                     end;
  1418.     DSortNameKey  : If DTTT.AllowSort and (SortOrder <> DSortName) then
  1419.                     begin
  1420.                         SortOrder := DSortName;
  1421.                         ReSort;
  1422.                     end;
  1423.     DSortExtKey   : If DTTT.AllowSort and (SortOrder <> DSortExt) then
  1424.                     begin
  1425.                         SortOrder := DSortExt;
  1426.                         ReSort;
  1427.                     end;
  1428.     DSortSizeKey  : If DTTT.AllowSort and (SortOrder <> DSortSize) then
  1429.                     begin
  1430.                         SortOrder := DSortSize;
  1431.                         ReSort;
  1432.                     end;
  1433.     DSortTimeKey  : If DTTT.AllowSort and (SortOrder <> DSortTime) then
  1434.                     begin
  1435.                         SortOrder := DSortTime;
  1436.                         ReSort;
  1437.                     end;
  1438.     DSortDOSKey   : If DTTT.AllowSort and (SortOrder <> DSortDOS) then
  1439.                     begin
  1440.                         SortOrder := DSortDOS;
  1441.                         ReSort;
  1442.                     end;
  1443.     DHelpKey      : If DTTT.AllowHelp then
  1444.                        ShowHelpScreen;
  1445.     DJumpParentKey: If DTTT.AllowCD and (length(PathName) > 3) then  {Enter}
  1446.                     begin
  1447.                         PathName := PathParent(PathName);
  1448.                         Release(DirTop);
  1449.                         DisplayNewDirectory;
  1450.                     end;
  1451.     DChangeDirKey : If DTTT.AllowCD then
  1452.                        PromptForDirectory;
  1453.     #33..#126     :  If DTTT.AllowInput then
  1454.                      begin               {user entered an alpha numeric}
  1455.                          ChosenFile := PromptForFilename(ChD);
  1456.                          If ChosenFile <> '' then
  1457.                          begin
  1458.                              If (ChosenFile[Length(ChosenFile)] = ':') then
  1459.                                  ChosenFile := ChosenFile +'*.*';
  1460.                              If (pos('*',ChosenFile) > 0)
  1461.                              or (pos('?',ChosenFile) > 0)
  1462.                              or (ChosenFile[Length(ChosenFile)] = '\') then
  1463.                              begin
  1464.                                  DIRFULLFileName := ChosenFile;
  1465.                                  Extract_Path_Mask;
  1466.                                  Release(DirTop);
  1467.                                  DisplayNewDirectory;
  1468.                              end
  1469.                              else
  1470.                              begin
  1471.                                 If (pos('\',ChosenFile) = 0)
  1472.                                 and (pos(':',ChosenFile) = 0) then
  1473.                                     ChosenFile := PathName + ChosenFile;
  1474.                                 Finished := true;
  1475.                              end;
  1476.                          end;
  1477.                      end;
  1478. {$ENDIF}
  1479.              #133,                                                 {Mouse left}
  1480.              #13  : If SubDirectory(FilePointer(HiFn)^.Attr) then  {Enter}
  1481.                     begin
  1482.                         If File_Name(HiFn) = '..' then
  1483.                            PathName := PathParent(PathName)
  1484.                         else
  1485.                            PathName := PathChild(File_Name(HiFn));
  1486.                         If (DTTT.SelectDir = false) then
  1487.                         begin
  1488.                            Release(DirTop);
  1489.                            DisplayNewDirectory;
  1490.                         end
  1491.                         else                      {return the Directory}
  1492.                         begin
  1493.                             Finished := true;
  1494.                             ChosenFile := PathNoSlash(PathName);
  1495.                         end;
  1496.                     end
  1497.                     else
  1498.                     begin
  1499.                         Finished := true;
  1500.                         ChosenFile := PathName+File_Name(HiFn);
  1501.                     end;
  1502.              #132,                          {mouse right}
  1503.              #027 : begin                   {esc}
  1504.                         Finished := true;
  1505.                         Retcode := EscCode;
  1506.                         ChosenFile := '';
  1507.                     end;
  1508.              end;  {case}
  1509.              If TotalFiles = 0 then
  1510.              begin
  1511.        {$IFDEF DIRFULL}
  1512.                    Repeat
  1513.                       Case No_Files_Found of
  1514.                       0 : exit;  {user selected a file}
  1515.                       99: begin  {user escaped}
  1516.                                Retcode := NoFilesCode;
  1517.                                Exit;
  1518.                             end;
  1519.                       end; {case}
  1520.                    until TotalFiles <> 0;
  1521.        {$ELSE}
  1522.                 Retcode := NoFilesCode;
  1523.                 Exit;
  1524.        {$ENDIF}
  1525.              end;
  1526.         Until Finished;
  1527.     end; {sub proc Process_Keys}
  1528.  
  1529.     Procedure SaveInitScreen;
  1530.     var S : word;
  1531.     begin
  1532.         S := 160*DisplayLines;
  1533.         If MaxAvail < S then
  1534.            NoMemory := true
  1535.         else
  1536.         begin
  1537.             Getmem(Scrn,160*DisplayLines);
  1538.             MoveFromScreen(Mem[BaseOfScreen:0],Scrn^,S div 2);
  1539.             FindCursor(CursRec[1],Cursrec[2],Cursrec[3],Cursrec[4]);
  1540.             OffCursor;
  1541.         end;
  1542.     end;
  1543.  
  1544.     Procedure Clear;
  1545.     begin
  1546.         If DTTT.RestoreScreen then
  1547.             MoveToScreen(Scrn^,mem[BaseofScreen:0],80*DisplayLines);
  1548.         PosCursor(Cursrec[1],Cursrec[2]);
  1549.         SizeCursor(Cursrec[3],Cursrec[4]);
  1550.         Release(HeapTop);
  1551.     end;
  1552.  
  1553. begin          {main procedure}
  1554.     Mark(HeapTop);
  1555.     NoMemory := False;
  1556.     Zoomed := False;
  1557.     ShowingDetails := DTTT.ShowDetails;
  1558.     SortAsc := DTTT.Asc = 1;
  1559.     SortOrder := DTTT.InitSort;
  1560.     If Not ShowingDetails then
  1561.        ColumnsWide := DTTT.ColsWide
  1562.     else
  1563.        Columnswide := 1;
  1564.     SaveInitScreen;
  1565.     If NoMemory then
  1566.     begin
  1567.         Retcode := Memcode;
  1568.         exit;
  1569.     end;
  1570.     {$I-}
  1571.     GetDir(0,StartDir);
  1572.     {SI+}
  1573.     If IOResult <> 0 then
  1574.     begin
  1575.         Retcode := UnknownCode;
  1576.         exit;
  1577.     end;
  1578.     Retcode := OKCode;     {assume it will succeed!}
  1579.     Extract_Path_Mask;
  1580.     Calculate_Box_Dimensions;
  1581.     Y3_unzoomed := Y3;   {ugh?}
  1582.     DisplayNewDirectory;
  1583.     If NoMemory then
  1584.     begin
  1585.        Clear;
  1586.        Retcode := Memcode;
  1587.     end
  1588.     else
  1589.        Process_Keys;
  1590.     Clear;
  1591.     Display_Directory := ChosenFile;
  1592. end;
  1593.  
  1594. begin
  1595.     Default_Settings;
  1596.     Horiz_Sensitivity := 3;
  1597. end.
  1598.